module adrawing
import StdEnv, japi

/* This program shows how to create a canvas,
   and draw figures like rectangles, circles,
   arcs, etc. It also shows how to save a ppm
   image of the drawings, and how to create a
   window. Pay special attention to the cliping
   rectangle. The program is large, since it
   exemplifies many functions. However, it has a
   very simple logic, and is easy to understand.
************************************************ */

                                      // ABREVIATIONS:
:: State = { fr::!Framer,             // fr::!F 
             canvas::!Canvas,         // canvas::!CP
             mousepressed::!Device,   // mousepressed::!D
             mousereleased::!Device,  // mousereleased::!D
             quit::!Entry,            // quit::!E
             save::!E,                // save::!E
             window::!C,              // window::!C
             label::!TDev}            // label::!TD



Start world
  # (js, world) = begin_japi world
    (frm, js) = jnewFrame (WH 600 550) "Draw Things" js
    (cv, js) = jnewCanvas (XYWH 0 0 600 550) frm  js
    cv = bg_color yellow   cv
    cv= jsetfont (TimesNew 20) cv
    txt= "Click the mouse anywhere on the canvas!"
    cv= jdraw  (Txt (30, 450) txt) cv
    cv= jsetfont (TimesNew 12) cv
    (cv, js) = jcliprect cv 30 40 400 370 js
    cv = bg_color  white cv
    (mnb, js) = jnewBar frm js
    (filemn, js) = jnewMenu  "File" mnb js 
    (sv, js) = jnewItem "Save" filemn  js
    (qt, js) = jnewItem  "Quit" filemn js
    (mp, cv) = jmousepressed cv
    (mr, cv) = jmousereleased cv
    (frm, js) = jshow frm js
    (w, js)= jnewWindow frm js;
    (lb, js)= jnewLabel FLOW "Hello, World!" w js
    (lb, js)= bg_namedcolor  J_MAGENTA (lb, js)
    (w, js)= jpack w js
    s= { fr= frm, canvas= cv, window= w,
         mousepressed= mp, mousereleased= mr,
         quit= qt, save= sv, label= lb}
    js = loop s js
  = end_japi js world
where
	loop :: !State !*JS -> *JS
	loop s js
		# 	(na, js)= jnextaction js
		|	na== (act s.fr) || na== (act s.quit)
		       # js= jdispose s.canvas js 
		       = jquit js
		| na== (act s.save) 
             # img= jgetimage s.canvas
             # (fname, js) = jfilesel s.fr "*.ppm" js
             # (_, js) = jsaveppm img fname js 
             = loop s js
        |   na== (act s.mousereleased)
                # (w, js)= jhide s.window js
                = loop {s& window=w} js
		|	na== (act s.mousepressed)
		        # m= s.mousepressed
				# (cv, js)= here (s.canvas, js) (mxy m)
				# img= jgetimage cv
				# pimg= (mxy m) + (40, 10)
				# cv= fill [ Hue yellow,
				             Xor True,
				             Cir pimg 50,
				 		     Xor False] cv
				# p= mxy m
				# lb= jsetText s.label (prt p)
				# (w, js)= setxy s.window p js
				# (w, js)= jshow s.window js
				= loop {s& canvas= cv, window=w, label=lb} js
		= loop s js
	
  	//here :: (!CP, !JS) !P -> (!CP, !JS)
    here (cv, js) p=:(x, y)
      # (r, js)= jrandom 255 js
      # (g, js)= jrandom 255 js
      # (b, js)= jrandom 255 js
      # cv = bg_color (r, g, b)  cv
      # cv= fill [ Hue green, Ovl p 60 50] cv 
      # cv= jdraw (Ovl p 60 50) cv
      # reye= (20, -20)
      # leye= (-20, -20)
      # cv= fill [Hue red, Cir (p+reye) 10] cv
      # cv= draw [Hue black, Cir (p+reye) 10] cv
      # cv= fill [Hue red, Cir (p+leye) 10] cv
      # cv= jdraw (Cir (p+leye) 10) cv
      # mouth= (0, 20)
      # cv= jdraw (Arc (p+mouth) 30 20 180 360) cv
      # p1= p+ (0, 60)
      # p2= p1+ (-20, -10)
      # p3= p2+ (0, 20)
      # q1= p+(0, 60)
      # q2= q1+(20, -10)
      # q3= q2+(0, 20)
      # cv= fill [  Hue red,
                    Tri p1 p2 p3,
                    Tri q1 q2 q3,
                    Hue black] cv 
      # cv= draw [  Tri p1 p2 p3,
                    Tri q1 q2 q3] cv 
      # cv= card cv (prt (x,y)) (x+50, y-60)
      = (cv, js)
      
    card cv txt p=:(x, y)
      # box= (x-20, y-20)
      # p1= box - (0, 4)
      # p2= p1 + (100, 0)
      # rbox= (x-15, y-15)
      # cv= jfillc green (Rct box 100 30) cv
      # cv= draw  [ Lin p1 p2,
                    Rct box 100 30,
                    Rrc rbox 90 20 10 10,
                    Cir (x, y-5) 5,
                    Txt (p+(10,0)) txt,
                    Arr (x+50,y+10) (x, y+25)] cv
      # pentagon= p+(50,60)
      # cv=  fill [ Hue red,
                    Plg (polygon pentagon 5 30),
                    Hue black] cv
      # cv= jdraw (Plg (polygon pentagon 5 35)) cv
      = cv  
	prt (x, y)=  "("+++(toString x)+++","+++(toString y)+++")"      

	polygon p n ir
		# pi2= 8.0 * (atan 1.0)
		# d= pi2/(toReal n)
		# r= toReal ir
		= loop n p r 0.0 d []
	where
		loop n p r ang d xs | n < 1 = xs
		loop n p r ang d xs
		  # s= sin ang
		  # c= cos ang
		  # v= (toInt(r*c), toInt(r*s))
		  = loop (n-1) p r (ang+d) d [v+p:xs]
		
		 